;; type.scm: Type routines for the r6rs-thrift compiler
;; Copyright (C) 2012 Julian Graham

;; r6rs-thrift is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.

;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with this program.  If not, see <http://www.gnu.org/licenses/>.

#!r6rs

(library (thrift compile type)
  (export thriftc:derive-namespace

          thriftc:enum-definition->type-descriptor
	  thriftc:struct-definition->type-descriptor)

  (import (rnrs)
	  (thrift compile parse)
	  (thrift private))

  (define (thriftc:enum-definition->type-descriptor definition location)
    (define (enum-value-definition->descriptor definition)
      (thrift:make-enum-value-descriptor
       (thriftc:enum-value-definition-name definition)
       (thriftc:enum-value-definition-ordinal definition)))

    (thrift:make-enum-field-type-descriptor
     (thriftc:enum-definition-name definition) location (thrift:wire-type enum)
     (map enum-value-definition->descriptor 
	  (thriftc:enum-definition-values definition))))

  (define (thriftc:struct-definition->type-descriptor definition location)
    (thrift:make-struct-field-type-descriptor
     (thriftc:struct-definition-name definition) location #f
     (map thriftc:field-definition-type
	  (thriftc:struct-definition-fields definition))
     (thriftc:struct-definition-exception? definition) 
     (thriftc:struct-definition-union? definition)))

  (define (thriftc:derive-namespace thrift)
    (let loop ((namespaces (thriftc:thrift-namespaces thrift))
               (namespace #f))
      (if (null? namespaces)
          (or namespace "thrift.default")
          (let* ((ns (car namespaces))
                 (lang (thriftc:namespace-language ns)))
            (case lang
              ((rnrs) (loop (cdr namespaces) (thriftc:namespace-name ns)))
              ((#f) (loop (cdr namespaces) 
                          (or namespace (thriftc:namespace-name ns))))
              (else (loop (cdr namespaces) namespace)))))))
)
